Developer CD Series 1992 June: ROMin Holiday

home *** CD-ROM | disk | FTP | other *** search

/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / Apple II / Essentials / Dynamo 4.2 for GSBug 1.5b10 / dynamo.includes / rtfp.macros < prev next >

Wrap

Text File | 1990-09-21 | 19.5 KB | 870 lines | [TEXT/MPS ]

*************************************** * This macro takes the value of a string and returns it in the acc,y. * If there is no op1, then the string number is assumed to be in the xreg. MACRO &lab _fstrval &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fstrval MEND *************************************** * This macro takes the value of op1 string starting at op2 character and * returns it in the acc,y. If there is no op1, then the string number is * assumed to be in the xreg. If there is no op2, then the character number * is assumed to be in the yreg. MACRO &lab _fmidstrval &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ycorm &op2 .jsr jsr fmidstrval MEND *************************************** * This macro reads a float from the current data pointer and advances the * pointer by five bytes. If there is no op1, then the destination variable * number is assumed to be in the xreg. MACRO &lab _readfloat &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr readfloat MEND *************************************** * This macro converts an integer variable into a floating-point variable. MACRO &lab _i2f &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr i2f MEND *************************************** * This macro converts a floating-point variable into an integer variable. MACRO &lab _f2i &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr f2i MEND *************************************** * This macro prints a float value. fout expects a pointer to the float. * The pointer is either already in a,y (no operand), or is * determined by the operand. MACRO &lab _fout &op &lab if &op='' goto .jsr fparm &op if finline=0 goto .jsr jsr frtsout _asc2fp &op mexit .jsr jsr fout MEND *************************************** * This macro prints a float value. This value is stored in a variable. * The variable number is either already in the xreg (no operand), or is * determined by the operand. MACRO &lab _fvout &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fvout MEND *************************************** * This macro multiplies the destination float variable by a float variable. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source variable number is * assumed to be in the yreg. MACRO &lab _fmulvar &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ldy #<&op2 .jsr jsr fmulvar MEND *************************************** * This macro multiplies the destination float variable by a float constant. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source float pointer is * assumed to be in a,y. MACRO &lab _fmul &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr fparm &op2 if finline=0 goto .jsr jsr frtsmul _asc2fp &op2 mexit .jsr jsr fmulcon MEND *************************************** * This macro divides the destination float variable by a float variable. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source variable number is * assumed to be in the yreg. MACRO &lab _fdivvar &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ldy #<&op2 .jsr jsr fdivvar MEND *************************************** * This macro divides the destination float variable by a float constant. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source float pointer is * assumed to be in a,y. MACRO &lab _fdiv &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr fparm &op2 if finline=0 goto .jsr jsr frtsdiv _asc2fp &op2 mexit .jsr jsr fdivcon MEND *************************************** * This macro adds a float variable to the destination float variable. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source variable number is * assumed to be in the yreg. MACRO &lab _faddvar &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ldy #<&op2 .jsr jsr faddvar MEND *************************************** * This macro adds a float constant the destination float variable. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source float pointer is * assumed to be in a,y. MACRO &lab _fadd &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr fparm &op2 if finline=0 goto .jsr jsr frtsadd _asc2fp &op2 mexit .jsr jsr faddcon MEND *************************************** * This macro subtracts a float variable from the destination float variable. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source variable number is * assumed to be in the yreg. MACRO &lab _fsubvar &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ldy #<&op2 .jsr jsr fsubvar MEND *************************************** * This macro subtracts a float constant from the destination float variable. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source float pointer is * assumed to be in a,y. MACRO &lab _fsub &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr fparm &op2 if finline=0 goto .jsr jsr frtssub _asc2fp &op2 mexit .jsr jsr fsubcon MEND *************************************** * This macro raises the destination float variable by the source float variable. * If there is no op1, then the destination variable number is assumed to be in * the xreg. If there is no op2, then the source variable number is assumed to * be in the yreg. MACRO &lab _fv2v &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ldy #<&op2 .jsr jsr fv2v MEND *************************************** * This macro raises the destination float variable by the a float constant. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source float pointer is * assumed to be in a,y. MACRO &lab _fv2con &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr fparm &op2 if finline=0 goto .jsr jsr frtsv2con _asc2fp &op2 mexit .jsr jsr fv2con MEND *************************************** * This macro gets the sign of the destination float variable and stores it in * the destination variable. If there is no op, then the destination variable * number is assumed to be in the xreg. MACRO &lab _fsgn &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fsgn MEND *************************************** * This macro gets the absolute value of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _fabs &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fabs MEND *************************************** * This macro gets the integer value of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _fint &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fint MEND *************************************** * This macro gets the square root of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _fsqr &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fsqr MEND *************************************** * This macro gets the log base e of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _flog &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr flog MEND *************************************** * This macro raises e to the destination float variable power and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _fexp &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fexp MEND *************************************** * This macro forms a 'random' number and stores it in the destination * variable. If there is no op, then the destination variable number * is assumed to be in the xreg. MACRO &lab _frnd &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr frnd MEND *************************************** * This macro gets the cos of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _fcos &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fcos MEND *************************************** * This macro gets the sin of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _fsin &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fsin MEND *************************************** * This macro gets the tan of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _ftan &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr ftan MEND *************************************** * This macro gets the arctan of the destination float variable and * stores it in the destination variable. If there is no op, then the * destination variable number is assumed to be in the xreg. MACRO &lab _fatn &op &lab if &op='' goto .jsr ldx #<&op .jsr jsr fatn MEND *************************************** * This macro sets a float variable to a 1-byte value. If there is no op1, * then the destination variable number is assumed to be in the xreg. If * there is no op2, then the value is assumed to be in the acc. MACRO &lab _i2fsetl &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr acorm &op2 .jsr jsr i2fsetconl MEND *************************************** * This macro sets a float variable to a 2-byte value. If there is no op1, * then the destination variable number is assumed to be in the xreg. If * there is no op2, then the value is assumed to be in the acc. MACRO &lab _i2fset &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr aycorm &op2 if ayisbyte=1 then jsr i2fsetconl mexit endif .jsr jsr i2fsetcon MEND *************************************** * This macro is used to set a bunch of float variables to integer constant * values. There must be a non-zero even number of parameters. The odd * parameters are the variables, and the even parameters are the constant * values for the preceeding parameter. The setvars routine uses the * return address as a pointer to the data (just like the write routine). * It simply sets the designated variable to the designated constant until * it encounters a 255 as a variable value. A 255 is reserved for this * purpose. This macro places a 255 at the end of the data list * automatically. MACRO &lab _i2fsetvars &lab if &syslist[2]='' then aerror '_setvars: must have at least two parameters' mexit endif jsr i2fsetvars lcla &i,&j,&n &i seta 1 &j seta 2 &n seta &nbr(&syslist) .a if &syslist[&j]='' then aerror '_i2fsetvars: must have even number of parameters' mexit endif dc.b &syslist[&i] if &substr(&syslist[&j],1,1)<>'#' then aerror '_i2fsetvars: variables can only be set to constants -- missing #' mexit endif dc.w &substr(&syslist[&j],2,999) &i seta &i+2 &j seta &j+2 if &i<=&n goto .a dc.b 255 MEND *************************************** * This macro is used to set a bunch of float variables to float constant * values. There must be a non-zero even number of parameters. The odd * parameters are the variables, and the even parameters are the constant * values for the preceeding parameter. The setvars routine uses the * return address as a pointer to the data (just like the write routine). * It simply sets the designated variable to the designated constant until * it encounters a 255 as a variable value. A 255 is reserved for this * purpose. This macro places a 255 at the end of the data list * automatically. MACRO &lab _fsetvars &lab if &syslist[2]='' then aerror '_setvars: must have at least two parameters' mexit endif jsr fsetvars lcla &i,&j,&n &i seta 1 &j seta 2 &n seta &nbr(&syslist) .a if &syslist[&j]='' then aerror '_fsetvars: must have even number of parameters' mexit endif dc.b &syslist[&i] if &substr(&syslist[&j],1,1)<>'#' then aerror '_fsetvars: variables can only be set to constants -- missing #' mexit endif _asc2fp &syslist[&j] &i seta &i+2 &j seta &j+2 if &i<=&n goto .a dc.b 255 MEND *************************************** * This macro sets the destination float variable to a float constant. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source float pointer is * assumed to be in a,y. MACRO &lab _fset &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr fparm &op2 if finline=0 goto .jsr jsr frtssetcon _asc2fp &op2 mexit .jsr jsr fsetcon MEND *************************************** MACRO &lab _fset0 &op &lab if &op='' goto .a ldx #<&op .a jsr fsetzero MEND *************************************** * This macro compares the destination float variable with a float variable. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source variable number is * assumed to be in the yreg. The equal status is true if the variables are * equal. If the xreg variable is greater or equal, then the carry is set. * If the xreg variable is smaller, then the carry is clear. MACRO &lab _fvcmp &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ldy #<&op2 .jsr jsr fvcmp MEND *************************************** * This macro compares the destination float variable with a float constant. * If there is no op1, then the destination variable number is assumed to be * in the xreg. If there is no op2, then the source variable number is * assumed to be in the yreg. The equal status is true if the values are * equal. If the xreg variable is greater or equal, then the carry is set. * If the xreg variable is smaller, then the carry is clear. MACRO &lab _fcmp &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr fparm &op2 if finline=0 goto .jsr jsr frtscmp _asc2fp &op2 mexit .jsr jsr fcmp MEND *************************************** * This macro sets a float variable to another float variable. If there is * no op1, then the destination variable number is assumed to be in the * xreg. If there is no op2, then the source variable number is assumed * to be in the yreg. MACRO &lab _fvarcpy &op1,&op2 &lab if &op1='' goto .a ldx #<&op1 .a if &op2='' goto .jsr ldy #<&op2 .jsr jsr fvarcpy MEND *************************************** *************************************** *************************************** * This macro generates an AppleSoft floating-point number. MACRO &lab _asc2fp &op lcla &exp,&mant ;Exponent and mantissa portions. lclc &str &str setc &op ;We can't modify the parm, so copy it. &lab if &substr(&str,1,1)='#' goto .const aerror 'floating-point constant parameter must start with a #' mexit .const &str setc &substr(&str,2,999) ;Get rid of #. lcla &sgn ;Get sign of number. &sgn seta $80000000 ;Assume positive. if &substr(&str,1,1)='-' then &sgn seta 0 &str setc &substr(&str,2,999) ;Get rid of -. endif if &substr(&str,1,1)='+' then ;Get rid of optional +. &str setc &substr(&str,2,999) endif lcla &dptflg,&dptcnt ;Setup work values. &dptflg seta 0 ;Decimal-point flag. &dptcnt seta 0 ;Decimal-point count. lclc &c,&s ;Work character and string. &s setc '' * This loop moves digits into &s, looks for a decimal-point, and * counts digits after a decimal-point. .loop1 &c setc &substr(&str,1,1) ;Get left-most character. if &c='' goto .brk1 ;End of string. &str setc &substr(&str,2,999) if &c<'0' goto .b ;Not digit. if &c>'9' goto .b ;Not digit. &s setc &concat(&s,&c) ;Collect the digit. if &dptflg=1 then &dptcnt seta &dptcnt+1 ;Count digits right of decimal. endif goto .loop1 .b if &c<>'.' goto .c if &dptflg=1 then aerror 'bad floating-point constant' ;Don't allow 2 decimal-points. endif &dptflg seta 1 ;Flag that we found first decimal-point. goto .loop1 .c if &c='e' goto .brk1 ;At exponent part. if &c='E' goto .brk1 ;At exponent part. aerror 'bad floating-point constant' ;Any other character is an error. mexit .brk1 &mant seta &strtoint(&s) ;Convert digits into a 4-byte integer. if &mant=0 then ;Special-case for 0. dc.b 0,0,0,0,0 mexit endif &exp seta 128+32 ;Normalize the number. .loop2 if &mant<0 goto .brk2 &exp seta &exp-1 &mant seta &mant<<1 goto .loop2 .brk2 lcla &expval,&expneg &expval seta 0 ;Default exponent value is 0. &expneg seta 0 ;Assume positive. if &str='' goto .doexp ;We have no exponent part. if &substr(&str,1,1)='-' then ;Check sign of exponent. &expneg seta 1 &str setc &substr(&str,2,999) ;Get rid of -. endif if &substr(&str,1,1)='+' then &str setc &substr(&str,2,999) ;Get rid of optional +. endif &expval seta &strtoint(&str) ;Get the exponent value. if &expneg=1 then &expval seta -&expval endif .doexp ;Process exponent portion. lcla &num,&mantlo,&manthi,&test ;Use this as a work variable. &expval seta &expval-&dptcnt ;Subtract frac digits from exponent. if &expval=0 goto .out ;No exponent adjustment. if &expval<0 goto .div10 ;Negative exponent adjustment. .mul10 &mantlo seta &mant**$00FFFFFF ;Break mantissa into lo and hi parts. &manthi seta &mant**$FF000000 &manthi seta &manthi>>1 &manthi seta &manthi**$7FFFFFFF &manthi seta &manthi>>7 &mantlo seta &mantlo*10 ;Multiply mantissa by 10. &manthi seta &manthi*10 .ma &test seta &manthi**$FF000000 if &test=0 goto .mb &exp seta &exp+1 &num seta &mantlo**$01 ;Keep this for rounding later. &manthi seta &manthi>>1 &manthi seta &manthi**$7FFFFFFF &mantlo seta &mantlo>>1 goto .ma .mb &manthi seta &manthi<<8 &mant seta &manthi+&mantlo+&num if &mant<0 goto .mc &mant seta $FFFFFFFF .mc &expval seta &expval-1 if &expval>0 goto .mul10 ;More multiplies. goto .out ;Finally, go do it. .div10 ;Keep as much precision as possible. &mantlo seta &mant>>1 ;Break mantissa into lo and hi parts. &mantlo seta &mantlo**$7FFFFFFF &mantlo seta &mantlo/1280 &mantlo seta &mantlo*2560 &mantlo seta &mant-&mantlo &manthi seta &mant-&mantlo &mantlo seta &mantlo<<8 &mantlo seta &mantlo/10 ;Divide mantissa by 10. &manthi seta &manthi>>1 &manthi seta &manthi**$7FFFFFFF &manthi seta &manthi/5 .da if &manthi<0 goto .db &exp seta &exp-1 &manthi seta &manthi<<1 &mantlo seta &mantlo<<1 goto .da .db &mantlo seta &mantlo>>7 &num seta &mantlo**$01 &mantlo seta &mantlo>>1 &mant seta &manthi+&mantlo+&num if &mant<0 goto .dc ;Final add didn't cause problems. &mant seta $FFFFFFFF .dc &expval seta &expval+1 if &expval<0 goto .div10 ;More divides. .out ;Finally, do it. &mant seta &mant--&sgn ;Pack the sign into the mantissa. lcla &m0,&m1,&m2,&m3 &m0 seta &mant**$FF &mant seta &mant>>8 &mant seta &mant**$00FFFFFF &m1 seta &mant**$FF &mant seta &mant>>8 &m2 seta &mant**$FF &m3 seta &mant>>8 dc.b &exp,&m3,&m2,&m1,&m0 ;Generate the code. mend